00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300		ENTRY	SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN
00400		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500		EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI
00600		DEFINE FIXX(N)
00700	<	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300				;	DIMENSION N(1)
01400		MM←1 ↔ NN←2 ↔ J←3
01500	LOOP:	0		;	DO 1 NN=I+L,J+L,K
01600		MOVE	1,@4(16)
01700		SUB 	1,@3(16) 	; MM IS IN 1
01800		MOVE	2,@(16)
01900		ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
02000		MOVE	3,@1(16)
02100		ADD	3,@3(16)	;J+L
02200		MOVE	4,@2(16)	;K
02300		HRRZI	5,@5(16)		; ADR. OF N
02400		ADDI	2,-1(5)		; N(NN)
02500		ADDI	3,-1(5)
02600		JUMPL	4,LP3		; JUMP IF NEG. INCR.
02700		HRRM	1,.+1		; ADD IN MM 
02800	LP1:	MOVE	6,(2)
02900		MOVEM	6,(2)		;N(NN)=N(NN+MM)
03000		CAIGE	2,(3)
03100		AOJA	2,LP1
03200		JRA	16,6(16)
03300	LP3:	HRRM	1,.+1
03400	LP2:	MOVE	6,(2)		;NEG. INCR.
03500		MOVEM	6,(2)
03600		CAILE	2,(3)
03700		SOJA	2,LP2
03800		JRA 	16,6(16)	;	END
03900	
04000	PLACE:	0	;	FUNCTION PLACE(X)
04100	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04200	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04300		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04400		FADR	2,XRN+=3999 	;END
04500		MOVMS	2
04600		MOVE 	0,.COMM.+=12	;R11
04700		FSBR	0,2
04800		JRA	16,1(16)
04900	
05000	FINDIT:	0    ;	FUNCTION FINDIT(N)
05100		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05200		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05300	;;	HRRZI	2,PTR  ;	FINDIT=0
05400	;;	ADDI	1,(2)  ;	L=PWDS(N)
05500	;;	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05600	;;	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05800	;;	HRRZI	3,XRN     ;377	FINDIT=-1
05900	;;	ADDI	3,(2)   ;	END
06000	;;	MOVE 5,(3)   ; RN(L+1)
06010		MOVE 2,PTR-1(1)		;THESE 3 REPLACE ABOVE
06020	;X	FIXX(2)
06030		MOVE 5,XRN(2)
06100		CAME	5,[1.0]
06200		JRST	FNEG
06210		MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
06300	;;	MOVE	5,1(3)  ;RN(L+2)
06310		MOVE 5,XRN+1(2)
06400		CAME	5,.COMM.
06500	FNEG:	SETO
06600		JRA	16,1(16)
06700	
06800	DPYNEW:	0    ;	SUBROUTINE DPYNEW
06900		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07000		JUMP	[1]    ;	CALL ACCPOG(1)
07100		MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
07200		JUMPG	2,DB    ;	CALL DPYOUT(1)
07300		JSA	16,DPYOUT    ;	END
07400		JUMP	[1]
07500	DB:	JRA	16,(16)
07600	
07700	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
07800		HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
07900		MOVE	5,@1(16)  ; I
08000		ADD	2,5  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
08100		ADD	2,@2(16)  ;	DIMENSION R(1)
08200		MOVE	3,-1(2)  ;	Y=R(JY+I)
08300		MOVM	4,3   ;	Z=ABS(Y)
08400		CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
08500		JRST	MV1
08600		CAML	5,[6]
08700		JRST	MV1	;  IF(I.GT.5)GO TO 1
08800	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
08900		JSA	16,AMOD  ;	Y=AMOD(Y,100.)
09000		JUMP	3  
09100		JUMP	[=100.0]  ; 0 HAS Y
09200		MOVE	5,@4(16)  ;	X=Y+W
09300		FADR	5,0
09400		MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
09500		MOVM	7,0 ;C  PUTS ALL INTO POSITIVE
09600		FSBR	4,7
09700		FADR	4,6
09800		SKIPGE 	5  ;	IF(X)Z=-Z
09900		MOVNS	4    ; Z
10000		JRST 	MV2 ;	GO TO 2
10100	MV1:	FADR	3,@4(16)  ;1	Z=Y+W
10200		MOVE	4,3   ; Z NOW IN 4
10300	MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
10400		ADD	3,@3(16)
10500		ADD	3,@1(16)
10600		MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
10700		JRA	16,5(16)	; END
10800	
10900	MVBX:	0   ;	SUBROUTINE MVBX(I)
11000	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11100		MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11200		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
11300	;;	HRRZI	4,XRN
11400	;;	ADDI	2,(4)
11500	;;	MOVE	3,-1(2)  ; R(JY+I)
11510		MOVE 3,XRN-1(2)
11600		FSBR	3,.COMM.+5
11700		FMPR	3,.COMM.+=25  ; *RDIS
11800		FADR	3,.COMM.+=9   ; +R8
11900		MOVE	2,@(16)
12000		ADD	2,.COMM.+=24   ; + L
12100	;;	ADDI	2,(4)
12200	;;	MOVEM	3,-1(2)    ;R(L+I)
12210		MOVEM 3,XRN-1(2)
12300		JRA	16,1(16)
12400	
12500	JUGGLE:	0    ;	SUBROUTINE JUGGLE
12600	;	IMPLICIT INTEGER(A-Z)
12700	;	REAL PWDS,RN
12800	;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
12900	;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13000		SOS	PTR+=250	;ITEM=ITEM-1
13100		HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
13200	;C  I-IX IS WD CNT OF NEW ITEM
13300		ADD	15,DPY+=4250
13400		MOVE	14,-1(15)
13500		FIXX(14)
13600		ADDI	14,3  		; JX
13700		MOVE	13,PTR+=253	;JY=IX
13800		MOVE	11,PTR+=252	; I
13900		SUB	11,13
14000		SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
14100		JUMPL	11,J2751   	;IF(Z)2751,172,751
14200		JUMPE	11,J172
14300		MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
14400		SUBI	5,1
14500		MOVE	10,DPY+=4250
14600		ADD	10,14
14700		JSA	16,LOOP
14800		JUMP	5
14900		JUMP	10
15000		JUMP	[-1]
15100		JUMP	11
15200		JUMP	[0]
15300		JUMP	XRN
15400		ADD	13,11		;JY=IX+Z
15500		JRST	J172		;GO TO 172
15600	J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
15700		ADD	14,11
15800		MOVE	5,11
15900		ADD	5,PTR+=253
16000		SOJ	5,
16100		MOVN	10,11
16200		JSA	16,LOOP
16300		JUMP	14
16400		JUMP	5
16500		JUMP	[1]
16600		JUMP	[0]
16700		JUMP	10
16800		JUMP	XRN
16900	;;J172:	HRRZI	12,XRN 		;  172	J=RN(JY)+2
17000	;;	ADDI	12,(13) 		; JY
17050	J172:	MOVE 12,XRN-1(13)
17100	;;	MOVE	12,-1(12) 	;RN(JY)
17200		FIXX(12)
17300		ADDI	12,2		; J IS IN 12
17400		JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
17500		JUMP	[0]
17600		JUMP	12
17700		JUMP	[1]
17800		JUMP	DPY+=4250	; MEDIT
17900		JUMP 	13		; JY
18000		JUMP	XRN
18100		MOVE	12,PTR+=253	; I=IX+Z
18200		ADD	12,11		; Z IS IN 11
18300		MOVEM	12,PTR+=252
18400		MOVE	12,PTR+=250  	; 1751	X=ITEM+1
18500		AOJ	12,	    	; X IS IN 12
18600		HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
18700		ADD	13,DL	
18800		MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
18900		SUB  	14,-1(13)	;JX IN 14
19000		HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
19100		ADDI	10,(12)
19200		MOVE	7,(10)		;WDS(X+1)
19300		SUB	7,-1(10)		;J IN 7
19400		MOVEM	7,MVBX		; STORE J
19500		SUB	7,14    	; Y=J-JX
19600		MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
19700		ADD	14,7
19800		AOJ	14,		; JX IN 14
19900		JUMPL	7,J2851   	;  IF(Y)2851,182,282
20000		JUMPE	7,J182
20100		MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
20200		ADDI	15,2	  	; ARG 1
20300		MOVE	6,-1(13) 	;  ARG 2
20400		JSA	16,LOOP
20500		JUMP	15
20600		JUMP	6 
20700		JUMP	[-1]
20800		JUMP	7	  	; Y
20900		JUMP	[0]
21000		JUMP	DPY
21100		JRST	J182   		;  GO TO 182
21200	J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
21300		ADD	14,7		;+Y
21400		ADDI	14,1		; ARG 1
21500		MOVE	5,-1(10) 	;WDS(X)
21600		ADD	5,7
21700		ADDI	5,1		; ARG 2
21800		MOVNM	7,MVBEAM	; -Y IS STORED
21900		JSA	16,LOOP
22000		JUMP	14
22100		JUMP	5
22200		JUMP	[1]
22300		JUMP	[0]
22400		JUMP	MVBEAM
22500		JUMP	DPY
22600		MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
22700		ADDI	14,1		; JX IN 14
22800	J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
22900		ADDI	5,1   	;WDS(X22)+1
23000		JSA	16,LOOP
23100		JUMP	[1]
23200		JUMP	MVBX
23300		JUMP	[1]
23400		JUMP	5  
23500		JUMP	14 
23600		JUMP	DPY
23700		MOVE	2,DL    	; DO 183 K=X22+1,X
23800	;;	HRRZI	5,DPY+=4000  	; 183	WDS(K)=WDS(K)+Y
23900	;;	ADD	5,2
24000		HRRZI	3,PTR
24100		ADDI	3,(2)
24200	;;	TLC	11,232000	; FLOAT Z
24300	;;	FADR	11,11
24400	J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
24500		MOVE	4,(3)
24600	;;	FADR	4,11		; ADD Z
24650		ADD 4,11
24700		MOVEM	4,(3)		; PWDS(K)=PWDS(K)+Z
24800		AOJ	3,	;UPDATE PWDS AND WDS
24900	J184:	JUMPE	7,J185
25000		MOVE	6,(13)
25100		ADD	6,7
25200		MOVEM	6,(13)
25300		ADDI	13,1
25400	J185:	CAIGE	2,(12)
25500		AOJA	2,J183
25600	;;	HRRZI	2,DPY+=4000	;ST(2)=WDS(X)
25700	;;	ADDI	2,(12)		;WDS(X+1) ADR.
25800	;;	MOVE	2,-1(2)
25850		MOVE 2,DPY+=3999(12)
25900	;;	HRRZI	3,DPY
26100	;;	MOVEM	2,1(3)
26150		MOVEM 2,DPY+1
26200		SETZM	DL		;X22=0
26300		JRA	16,(16)
26400	
26500	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
26600		MOVEI	2,2	;DIMENSION RPOS(2,200)
26700	S3:	MOVE	6,2	;(K=L HERE)
26800		SETO	11,	;L=2
26900		HRRZI	3,@(16)	;3	J=-1
27000		MOVE	4,2	;RX=RPOS(1,L-1)
27100		SUBI	4,1	;L-1
27200		IMULI	4,2
27300		ADDI	4,(3)
27400		MOVE	5,-2(4)	;RX
27500	S2:	MOVE 	7,6	;	DO 2 K=L,M
27600	;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
27700		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
27800		ADDI	7,(3)
27900		CAMG	5,-2(7)
28000		JRST	S1	; CONTINUE
28100		MOVE	5,-2(7)	;  RX=RPOS(1,K)
28200	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
28300		MOVE 	11,6	;J=K
28400	S1:	CAMGE	6,@1(16)	;2	CONTINUE
28500		AOJA	6,S2
28600		JUMPL	11,S4	;IF(J)GO TO 4
28700		MOVE	12,2	;K=L-1
28800		SOS	12
28900		IMULI	12,2	;(K*2)
29000		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
29100		MOVE	10,-2(12)
29200	;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
29300		IMULI	11,2
29400		ADD	11,3
29500		EXCH	10,-2(11)
29600		MOVEM	10,-2(12)
29700		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
29800		EXCH	10,-1(11)
29900		MOVEM	10,-1(12)
30000	S4:	CAMGE	2,@1(16)	;4	L=L+1
30100		AOJA	2,S3		;IF(L.LE.M)GO TO 3
30200		JRA	16,2(16)	;END
30300	
30400	XNOTE:	0		;FUNCTION XNOTE(J)
30500		MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
30600		IMULI	3,12		;DIMENSION R(10,80)
30700	;;	ADDI	3,XRN+=2993	;EQUIVALENCE (R,RN(3001))
30800	;;	MOVE	2,(3)		;XNOTE=AMOD(R(4,J),100.)
30850		MOVE 2,XRN+=2993(3)
30900		JSA	16,AMOD
31000		JUMP	2
31100		JUMP	[=100.0]
31200		JRA	16,1(16)	;END
31300	
31400	BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
31500		MOVE	2,@(16)		;C  FOR AUTOMATIC BEAMS.
31600		ADDI	2,2  	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
31700		MOVEM	2,@(16)		;J=J+2
31800		MOVE	3,@3(16)
31900		MOVE	4,@1(16)
32000		SUB	4,3		;L-N
32100		MOVE	5,@2(16)
32200		SUB	5,3		;K-N
32300	;;	HRRZI	6,SCM
32400	;;	ADDI	6,(2)
32500		TLC	4,232000
32600		FADR	4,4		;FLOATS IT
32700	;;	MOVEM	4,-2(6)		;V(J-1)=L-N
32750		MOVEM 4,SCM-2(2)
32800		TLC	5,232000
32900		FADR	5,5		;FLOATS IT
33000	;;	MOVEM	5,-1(6)		;V(J)=K-N
33050		MOVEM 5,SCM-1(2)
33100		JRA	16,4(16)
33200	
33300	UPDATE:	0	;	SUBROUTINE UPDATE(I)
33400	;;	HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
33500	;;	ADD	3,PTR+=252	;RN(IS)=I
33550		MOVE 3,PTR+=252
33600		MOVE	2,@(16)
33700		TLC	2,232000	;FLOAT I
33800		FADR	2,2
33900	;;	MOVEM	2,-1(3)
33950		MOVEM 2,XRN-1(3)
34000	;;	MOVE	2,PTR+=252
34100	;;	ADD	2,@(16)
34200	;;	ADDI	2,3
34300	;;	MOVEM	2,PTR+=252	;IS=IS+I+3
34310		MOVE 2,@(16)
34320		ADDI 2,3
34330		ADDM 2,PTR+=252
34400		JRA	16,1(16)
34500	
34600	JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
34700	IK:	0
34800	JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
34900	NEWR:	0	;	SUBROUTINE NEWR
35000		MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
35100		CAIE	A,1		;COMMON/XRN/RN(4000)
35200		JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
35300		MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(22),JX,U,JZ,IRHY,J4,KA,KB,IZ
35400		MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
35500		MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
35600	 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
35700	N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
35800		MOVEM	IS,PTR+=252
35810		MOVE 14,[9999.0]
35900		MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
36000		ADDI	JT,1		;IK=IS
36100		MOVEM	JT,PTR+=250	;JIT=ITEM
36200		MOVEI	K,=10		;1	IS=IK
36300		MOVE	IZ,SCX+=33	;ITEM=JIT+1
36400		IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
36500	;;N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
36510	;;;;N2:	MOVE	R,XRN+=2997(K)	;DO 2 K=1,IZ
36600	;;	ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
36700	;;	MOVE	R,(R)
36800	;;;;	CAMN	R,[=9999.0]
36850	N2:	CAMN 14,XRN+=2997(K)
36900		JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
37000		SETO	IEND,		;C  JUMP FOR BEAM CONT.
37100	;;	HRRZI	L,XRN		;IEND=-1
37200	;;	ADD	L,PTR+=252	;RN(IS+3)=0
37300	;;	SETZM	2(L)
37400	;;	SETZM	1(L)		;RN(IS+2)=0
37410		MOVE L,PTR+=252
37420		SETZM XRN+2(L)
37430		SETZM XRN+1(L)
37500		MOVEI	L,=9 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
37600	;;N3:	HRRZI	R,XRN+=3000	;DO 3 L=9,1,-1
37610	N3:	HRRZI	R,XRN+=3000(K)	;DO 3 L=9,1,-1
37700	;;	ADDI	R,(K)		;A=R(L,K)
37800		ADDI	R,(L)
37900		MOVE	A,-13(R)	;(OCTAL)=-11
38000		JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
38100		JUMPN	A,NX3		;IF(IEND)GO TO 3
38200		JRST	NN3
38300	NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
38400	;;NX4:	HRRZI	R,XRN
38500	;;	ADD	R,PTR+=252	;RN(IS+L)=A
38600	;;	ADDI	R,(L)
38700	;;	MOVEM	A,-1(R)
38710	NX4:	MOVE R,PTR+=252
38720		ADDI R,(L)
38730		MOVEM A,XRN-1(R)
38800	NN3:	CAILE	L,1		;3	CONTINUE
38900		SOJA	L,N3
39000		CAIGE	IEND,3
39100		MOVEI	IEND,3
39200		MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
39300		SUBI	15,2
39400		JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
39500		JUMP	15
39600	NN2:	CAML	K,IZ		;2	CONTINUE
39700		JRA	16,(16)		;END
39800		ADDI	K,=10
39900		JRST	N2
40000	
40025	CNT:	0
40050	MSSLUP:	0
40100		SETZ	1,		;161	CNT=1
40150		SETZ	2,
40200	L5543:	MOVE	3,.COMM.+4(2)	;DO 5543 K=1,9
40300	;;	ADDI	3,(2)
40400	;;	MOVE	3,(3)		;RA=RJQ(K)
40500		SKIPE	3		;IF(RA.NE.0)CNT=K
40550		MOVE	1,2
40600	;;	MOVEI	4,RRJJ+1	;5543	RJJ(K)=RA
40700	;;	ADDI	4,(2)
40800	;;	MOVEM	3,(4)
40810		MOVEM 3,RRJJ+1(2)
40900		CAIG	2,7		; LOOP BACK?
41000		AOJA	2,L5543
41100		AOJ	1,
41200		MOVEM	1,CNT		;REMEMBERS CNT
41300		JRA	16,(16)
41400	
41500	LUP2:	0
41600	;;	MOVEI	1,XRN		;261	RN(I)=CNT
41650	;;	ADD	1,PTR+=252
41675		MOVE	2,CNT
41680		TLC	2,232000
41690		FADR	2,2		;FLOATS IT
41695	;;	MOVEM	2,-1(1)
41697		MOVE 1,PTR+=252
41698		MOVEM 2,XRN-1(1)
41700		MOVE	2,.COMM.+1	;RN(I+1)=JA
41710		TLC	2,232000
41720		FADR	2,2
41730	;;	MOVEM	2,(1)
41800	;;	MOVE	2,PTR+=252	;I=I+2
41810	;;	ADDI	2,2
41820	;;	MOVEM	2,PTR+=252
41830		MOVEM 2,XRN(1)
41840		ADDI 1,2
41850		MOVEM 1,PTR+=252
41900		MOVE	3,.COMM.	;RN(I)=R2
41910	;;	MOVEM	3,1(1)
41920		MOVEM 3,XRN-1(1)
42000	;; NOT USED NOW!	IF(RD.NE.0)RN(I)=RD
42100	;;C TO SAVE NOTE NUMBS IN P2.
42200		SETZ	5,		;DO 4554 K=1,CNT
42205	L4554:	MOVE 2,.COMM.+4(5)
42210	;;L4554:	MOVEI	2,.COMM.+4	;(RJQ)
42220	;;	ADDI	2,(5)
42230	;;	MOVE	2,(2)
42235	;;	MOVEI	3,XRN(5)
42237	;;	ADDI	3,(5)
42240	;;	ADD	3,PTR+=252
42300	;;	MOVEM	2,(3)		;4554	RN(I+K)=RJQ(K)
42305		MOVE 3,1
42307		ADDI 3,(5)
42308		MOVEM 2,XRN(3)
42310		AOJ	5,
42320		CAME	5,CNT
42330		JRST	L4554
42340		AOJ	5,
42350	;;	ADD	5,PTR+=252
42360		ADDM 5,PTR+=252
42400	;;	MOVEM	5,PTR+=252	;3554	I=CNT+1+I
42410		JRA	16,(16)
42420	
43000	RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
43100	;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
43200	;;	SUBROUTINE HOMER
43300	;;	IMPLICIT INTEGER(A-Q,S-Z)
43400	;;	REAL PWDS,DISX,A,B,PLACE,STFF
43500	;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
43600	;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
43700	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
43800	;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
43900	;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
44000	;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
44100	;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
44200	HOMER:	0		; IF(JA.EQ.6)GO TO 9
44300		MOVE	MM,.COMM.+1
44400		CAIN	MM,6
44500		JRST	H9
44600		SKIPE	.COMM.+=14	;IF(R13.NE.0)GO TO 10
44700		JRST	H10	; FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
44800		SKIPN	.COMM.+=24	;IF(JQ(1).EQ.0)GO TO 197
44900		JRST	H197	; TO HOME IN ON NOTE ON DIFFERENT STAFF.
45000		MOVE	K,.COMM.	;JJ2=R2
45100		FIXX(K)
45200		MOVEM	K,POSI+=8	; JJ2 FOR RUNTHR
45300		MOVE	K,PTR-1(K)	;K=PWDS(JJ2) ← BEAM PTR.
45350	;X	FIXX(K)
45550		MOVE 	L,.COMM.+=24
45600		MOVE	L,PTR-1(L)	;L=PWDS(JQ(1))  ← NOTE PTR.
45620	;X	FIXX(L)
45700		MOVEI	JT,XRN(K)	;RA=RN(K+3)
45800	;;	ADDI	JT,(K)
45900		MOVEM	JT,UPDATE	;SAVE LOC OF RN(K+1)
46000		MOVE	IS,2(JT)	
46100		MOVEM	IS,JIT		;RA SAVED IN JIT
46200		MOVEI	JK,XRN(L)	;RB=RN(L+3)
46300	;;	ADDI	JK,(L)
46310		MOVE RC,3(JK)	; RN(L+4)
46320		MOVE NX,[1.0]
46330		SKIPGE RC
46340		MOVNS RC
46350		CAML RC,[90.0]
46360		MOVE NX,[0.6]	; FOR MINI NOTES AND BEAMS
46400	H400:	MOVEM	JK,NEWR		;LOC OF RN(L+1)
46500		MOVE	IZ,2(JK)   ; RB=POS OF NOTE,  RA=POS(P3) OF BEAM
46600		MOVEM	IZ,IK		; RB SAVED IN IK
46700		SETZM	JUGGLE		;N=0
46800		MOVE	0,4(JK)		;IF(RN(L+5).LT.20)N=-1
46900		CAMGE	0,[=20.0]
47000		SETOM	JUGGLE		; -1 MEANS STEM IS UP
47100		MOVN	0,6(JT)		;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
47120		MOVEM	0,XNOTE		;RN(K+7)
47140		JSA	16,AMOD
47160		JUMP	XNOTE
47180		JUMP	[=10.0]
47200		FADR	0,[=1.0]
47220		FMPR	0,[=1.5714]
47240		FMPR 0,NX
47260		MOVEM	0,SORT2		;RG SAVED IN SORT2
47280	;   SPACE FOR THE NUMB. OF BEAMS
48100		MOVE	L,NEWR		;J11=RN(L+2) ←STAFF # OF NOTE
48200		MOVE	JT,1(L)
48300		FIXX(JT)		; J11 IS IN JT
48400		SETZ	MM,		;M=0
48500		MOVE	K,UPDATE		;IF(RN(K+7).LT.20.)M=-1
48600		MOVE	JK,6(K)		;RN(K+7)
48700		CAMGE	JK,[=20.0]
48800		SETO	MM,
48900		MOVE	JK,1(K)		;X=RN(K+2) ←STAFF # OF BEAM
49000		FIXX(JK)		; X IS IN JK
49100	;  THE STAFF NUMS.  X=BEAM   J11=NOTE
49475		MOVE	IS,STF+3(JK)	;R3=RSTFAC(X)  R3 IS IN 'IS'
49480		FMPR IS,NX
49487	;;	MOVE	IZ,STF+3(JT)	;R9=RSTFAC(J11)/R3
49800	;;	FDVR	IZ,IS		;R9 IS IN IZ
49900		FMPR	IS,[=2.43959732]	;R8=R3*14.54/5.96
50000	;  R8=WIDTH OF NOTE
50100	;******* 5/74  BOTH STAVES MUST BE SAME SIZE - MOST LIKELY ********
50200		MOVE	A,[=13.7142857]		;R7=96./7.
50300	;C  MUST BE DOUBLE STEM LENGTH
50310		FMPR A,NX	; *RMINI
50400		MOVE	R,7(L)		;RD=RN(L+8) ← STEM LENGTH
50500	;  THE STEM LENGTH
50510		CAMN	R,[=999.0]
50520		SETZM	R		;IF(RD.EQ.999)RD=0
50600		CAME	MM,JUGGLE	;3	IF(M.NE.N)GO TO 5
50700		JRST	H5
50800		SETZ	IS,		;R8=0
50900		SETZ	A,		;R7=0
51000		SETZM	SORT2		;RG=0
51100		JRST 	H4		;GO TO 4
51200	H5:	JUMPE	MM,H4		;5	IF(M.EQ.0)GO TO 4
51300		MOVNS	A	      ;	R7=-R7
51400		MOVNS	IS		;R8=-R8
51500		MOVNS	R		;RD=-RD
51600		MOVNS	SORT2		;RG=-RG
51700	
51800	;  NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
51900	H4:	FADR	IS,IK		;4	RN(K+6)=RB+R8
52000		MOVEM	IS,5(K)		;SETS CORRECT HORIZONTAL PARAM OF BEAM.
52100	;;	MOVE	MM,IZ		;RF=7.*R9
52200	;;	FMPR	MM,[=7.0]
52250		MOVE	NN,POSI+3(JT)
52850		FSBR	NN,POSI+3(JK) ; RE=(STFF(J11)-STFF(X))/RF
52900		FDVR	NN,[7.0]
53000	;  DIST BETWEEN STAVES.
53100		FADR	A,R		;RN(K+5)=RN(L+4)+RE+(R7+RD+RG)*R9
53200		FADR	A,SORT2
53300	;;	FMPR	A,IZ
53400		FADR	A,NN
53500		FADR	A,3(L)
53503		CAMG A,[90.0]		; CHECK FOR NEG. MINI POSITION
53506		JRST .+5
53509		CAML A,[100.0]
53510		JRST .+5
53512		FSBR A,[200.0]		;  MAKE 90'S INTO -100'S
53520		JRST .+2
53530		CAMG A,[-80.0]
53540		FADR A,[200.0]
53600		MOVEM	A,4(K)
53700		JRA	16,(16)		;RETURN
53800	
53900	;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
54000	H197:	SETOM	POSI+=8		;197	JJ2=-1
54100		MOVE	R,.COMM.		;R3=R2
54200		MOVEM	R,JIT
54300		SETZ	K,		;DO 191 K=1,ITEM
54400	H191:	MOVEM	K,LOOP		;SAVE K
54500	;;	MOVEI	L,PTR		;       	L=PWDS(K)
54600	;;	ADDI	L,(K)
54650		MOVE	L,PTR(K)	; L IS PWDS(K+1)
54700	;;	MOVE	L,(L)
54800	;X	FIXX(L)
54900	;;	MOVEI	R,XRN		;IF(RN(L+1).NE.6)GO TO 191
54950		MOVEI	R,XRN(L)
55000	;;	ADDI	R,(L)		;LOC OF RN(L+1)
55100		MOVE	A,(R)
55200		CAME	A,[=6.0]
55300		JRST	HX191
55400		MOVE	J,JIT		;IF(RN(L+2).EQ.R3)GO TO 77
55500		CAMN	J,1(R)
55600		JRST	H77
55700		CAMGE	J,[=5.0]	;IF(R3.LT.5.)GO TO 191
55800		JRST 	HX191		; TYPE 19 99 FOR ALL STAVES
55900	H77:	MOVE	J,-1(R)		;77
56000		CAMN	J,[=8.0]	;IF(RN(L).EQ.8)GO TO 191
56050		JRST	HX191
56100		MOVE	J,6(R)		;IF(RN(L+7).LT.10.)GO TO 191
56200		CAMGE	J,[=10.0]	;C  FINDS BEAMS.
56300		JRST	HX191
56400		FDVR	J,[=10.0]	;X=RG/10.
56500		FIXX(J)			;C  STEM DIRECT.
56600		MOVEM	J,IK		;X SAVED IN IK
56700		MOVE	J,1(R)		;R2=RN(L+2)
56800		MOVEM	J,.COMM.	; USED IN 'FINDIT'
56900		MOVE	A,2(R)		;A=RN(L+3)-.01
57000		FSBR	A,[=0.01]
57100		MOVEM	A,NEWR		;SAVE A IN NEWR
57200		MOVE	J,5(R)		;B=RN(L+6)+.01
57300		FADR	J,[=0.01]	;C  POS 1 AND 2
57400		MOVEM	J,BAUTO		;B SAVED IN BAUTO
57500		FSBR	J,A		;DISX=B-A
57600		MOVEM	J,UPDATE	;DISX SAVED IN UPDATE
57700	;  DISTANCE IN REAL STEPS
57800		MOVEM	R,MVBX		;SAVE LOC OF RN(L+1)
57850		MOVE	0,3(R)
57875		MOVEM	0,JUGGLE
57900		JSA	16,AMOD		;RF=AMOD(RN(L+4),100.0)
58000		JUMP	JUGGLE
58100		JUMP	[=100.0]
58200		MOVEM	0,JUGGLE	; THIS IS RF!!!!
58300	;  NOTE 2
58350		MOVE	J,MVBX
58375		MOVE	J,4(J)
58387		MOVEM	J,MSSLUP
58400		JSA	16,AMOD		;RB=AMOD(RN(L+5),100.0)
58500		JUMP	MSSLUP 
58600		JUMP	[=100.0]	;0 WILL HAVE RB!!!
58700		FSBR	0,JUGGLE
58800		MOVEM	0,SORT2		;RD SAVED IN SORT2  --  RD=RB-RF
58900	;  HEIGHT
59000		MOVEI	NX,1
59100	;;H192:	MOVEM	NX,DPYNEW	;	DO 192	N=1,ITEM
59200	H192:	JSA	16,FINDIT	;IF(FINDIT(N))GO TO 192
59300	;;	JUMP	DPYNEW
59350		JUMP	NX
59400		JUMPL	0,HX192
59500		MOVEI	R,XRN		;IF(RN(L).EQ.8)GO TO 192
59600		ADD	R,PTR+=251	;LOC OF RN(L+1)
59700		MOVE	J,-1(R)
59800		CAMN	J,[=8.0]
59900		JRST	HX192
60000		MOVE	J,7(R)		;IF(RN(L+8).EQ.1000.)GO TO 192
60100		CAMN	J,[=1000.0]
60200		JRST	HX192	; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
60300	;  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
60400		MOVE	A,2(R)		;RC=RN(L+3)
60500		CAMGE	A,NEWR		;IF(RC.LT.A)GO TO 192
60600		JRST	HX192
60700		CAMLE	A,BAUTO		;IF(RC.GT.B)GO TO 192
60800		JRST	HX192	;  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
60900		MOVE	J,4(R)		;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
61000		FDVR	J,[=10.0]
61100		FIXX(J)
61200		CAME	J,IK
61300		JRST	HX192
61400		FSBR	A,NEWR		;RC=RC-A
61500		MOVEM	A,MVBEAM	;SAVES RC
61600		MOVEM	R,MVBX		;SAVE LOC OF RN(L+1)
61610		MOVE 	0,3(R)
61620		MOVEM	0,MSSLUP
61700		JSA	16,AMOD		;193	RE=AMOD(RN(L+4),100.0)
61800		JUMP	MSSLUP
61900		JUMP	[=100.0]
62000		MOVEM	0,ALF+3		;RE SAVE HERE
62100		MOVE	J,SORT2		;RC=RD*RC/DISX+RF
62200		FMPR	J,MVBEAM	;*RC
62300		FDVR	J,UPDATE	;/DISX
62400		FADR	J,JUGGLE	;+RF
62500		MOVEM	J,MVBEAM	;RC=
62510		MOVE	J,MVBX
62520		MOVE	J,6(J)		;RG=RN(L+7)
62700		MOVEM	J,ALF+4		;SAVE RG
62800		JSA	16,AMOD		;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
62900		JUMP	ALF+4
63000		JUMP	[=10.0]
63100		MOVEM	0,LUP2
63200		JSA	16,AMOD
63300		JUMP	ALF+4
63400		JUMP	[=1.0]
63500		FSBR	0,LUP2
63600		FADR	0,ALF+4
63650		MOVE	L,MVBX
63700		MOVEM	0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
63800	;  FRACTIONAL NOTE #
63900		MOVE	R,MVBEAM	;195	RA=RC-RE
64000		FSBR	R,ALF+3
64100		MOVE	J,IK		;IF(X.EQ.2)RA=-RA
64200		CAIN	J,2
64300		MOVNS	R
64400		SKIPN	R		;IF(RA.EQ.0)RA=999.
64500		MOVE	R,[=999.0]
64600		MOVEM	R,7(L)		;196	RN(L+8)=RA
64700	;  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
64800	;;	MOVE	NX,DPYNEW		;IF(JJ2)JJ2=N
64900		SKIPGE	POSI+=8
65000		MOVEM	NX,POSI+=8	;  SAVES # OF FIRST ITEM FOUND
65100	HX192:	CAMGE	NX,PTR+=250	;192	CONTINUE
65200		AOJA	NX,H192
65300	HX191:	MOVE	K,LOOP		;191	CONTINUE
65400		CAMGE	K,PTR+=250
65500		AOJA	K,H191
65600		JRA	16,(16)		;RETURN
65700	
65800	H9:	SKIPGE	.COMM.+=32	;9	IF(J11.LT.0)RETURN
65900		JRA	16,(16)		;   IF P11=-1 NO HOMING
66000		MOVE	R,.COMM.+=8	;	X=R7/10.
66100		FDVR	R,[=10.0]
66200		FIXX(R)
66300		SKIPGE	R		;IF(X)X=-X
66400		MOVNS	R
66500		MOVEM	R,IK		;X SAVED IN IK
66600	;  X IS STEM DIRECTION
66700		MOVE	L,.COMM.+=10	;RA=R9
66800	;  R9= POS3
66900		MOVNI	RC,1	;RC=-1 
67000		SKIPE	L		;IF(R9.NE.0)RC=-2
67100		MOVNI	RC,2
67200		MOVE	J,.COMM.+=31	;IF(J10/10.EQ.3)RC=-3
67300		IDIVI	J,=10
67400		CAIN	J,3
67500		MOVNI	RC,3		;  RC=0 ESCAPES FRCOM LOOP.
67510	;;;	JRST	HZ10
67520	;;;H10:	SETZ	RC,		;FOR P13=1
67600	;   HOMING RANGE FOR BEAMS
67700	;;;HZ10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
67710	H10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
67800		JUMPN	IS,HX10
67900		MOVE	IS,[=2.9]
68000		MOVEM	IS,.COMM.+=12	;   IF P11.NE.0 RANGE IS CHANGED FROM 2
68100	HX10:	MOVE	IZ,.COMM.+1	;	IF(JA.EQ.5)RC=-1
68200		CAIN	IZ,5
68300		MOVNI	RC,1
68400		MOVEI	K,1
68500	H361:	JSA	16,FINDIT		;DO 361 K=1,ITEM
68600		JUMP	K
68700		JUMPL	0,HX361		;IF(FINDIT(K))GO TO 361
68800	;  SKIPS NOTES ON WRONG LINE 
68900		MOVEI	R,XRN		;RD=RN(L+3)
69000		ADD	R,PTR+=251	;LOC OF RN(L+1)
69100		MOVE	A,2(R)		;RD IN A
69200		MOVEM	A,XRN+=3999	;1	IF(JA.NE.6)GO TO 177
69300		MOVE	J,.COMM.+1
69400		CAIE	J,6
69500		JRST	H177
69600		MOVE	J,4(R)		;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
69700		FDVR	J,[=10.0]
69800		FIXX(J)
69900		CAME	J,IK
70000		JRST	HX361
70100	H177:	JSA	16,PLACE	;177	IF(PLACE(R3))GO TO 461
70200		JUMP	.COMM.+4
70300		JUMPL	H461
70400		MOVEM	A,.COMM.+4	;R3=RD
70500	;  LOOKS FOR NOTE, STAFF #, STEM DIR.
70600		MOVE	J,.COMM.+1	;IF(JA.EQ.6)GO TO 861
70700		CAIN	J,6
70800		JRST	 H861
70900		CAIN	J,5		;IF(JA.EQ.5)GO TO 261
71000		JRST	H261
71100		JRA	16,(16)		;RETURN
71200	H461:	MOVE	J,.COMM.+1	;461	IF(JA.EQ.6)GO TO 277
71300		CAIN	J,6
71400		JRST	H277
71500		CAIE	J,5		;IF(JA.NE.5)GO TO 361
71600		JRST	HX361
71700	H277:	JSA	16,PLACE	;277	IF(PLACE(R6))GO TO 561
71800		JUMP	.COMM.+7
71900		JUMPL	H561
72000		MOVEM	A,.COMM.+7	;R6=RD
72100	H861:	MOVE	0,.COMM.+=28	;861	IF(J7.GE.0)GO TO 261
72200		JUMPGE	0,H261
72300	H561:	JSA	16,PLACE	;561	IF(PLACE(RA))GO TO 661
72400		JUMP	L
72500		JUMPL	H661
72600		MOVE	0,.COMM.+=28	;IF(J7)GO TO 761
72700		JUMPL	H761	;  J7=NEG MEANS TREMOLO
72800		MOVE	0,.COMM.+=9	;	IF(R8.NE.0)GO TO 761
72900		JUMPN	H761
72910		MOVE	0,.COMM.+=11	;	IF(R10.EQ.0)GO TO 361
72920		JUMPE	HX361
73000	H761:	MOVEM	A,.COMM.+=10	;761	R9=RD
73100	;  R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
73200		JRST	H261		;GO TO 261
73300	H661:	CAIN	J,5		;661	IF(JA.EQ.5)GO TO 361
73400		JRST	HX361
73500		MOVE	0,.COMM.+=31	;IF(J10.LT.30)GO TO 361
73600		CAIGE	0,=30
73700		JRST	HX361
73800		JSA	16,PLACE	;IF(PLACE(R8))GO TO 361
73900		JUMP	.COMM.+=9
74000		JUMPL	HX361	; HOMES INNER PARTIAL BEAMS
74100		MOVEM	A,.COMM.+=9	;R8=RD
74200	H261:	SKIPN	RC       	;261	IF(RC.EQ.0)RETURN
74300		JRA	16,(16)    
74400		AOJ	RC		;RC=RC+1
74500	HX361:	CAMGE	K,PTR+=250	;361 	CONTINUE
74600		AOJA	K,H361
74700		JRA	16,(16)		;	END
74800	
75100	;	CALL FSCAN
75200	;	GOTO RT
75300	;	GOTO LF
75400	;	GOTO UP
75500	;	GOTO DW
75600	;	GOTO 1/2
75700	;	GOTO *2
75800	;	GOTO X
75900	;	GOTO C
76000	;	ALL OTHERS(EXIT)
76100	
76200	FSCAN:	0
76300		INCHRW
76400		CAIN ";"
76500		JRA 16,(16)
76600		CAIN ":"
76700		JRA 16,1(16)
76800		CAIN "("
76900		JRA 16,2(16)
77000		CAIN ")"
77100		JRA 16,3(16)
77200		CAIN "/"
77300		JRA 16,4(16)
77400		CAIN "*"
77500		JRA 16,5(16)
77600		CAIN "X"
77700		JRA 16,6(16)
77800		CAIN "C"
77900		JRA 16,7(16)
78000		JRA 16,8(16)
78100		END